home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / backup.arc / BACKUP.CLP next >
Encoding:
Text File  |  1991-12-04  |  35.6 KB  |  445 lines
  1.         /*~  CRTCLPGM PGM(BACKUP.YOURLIB) SRCFILE(YOUSRC.YOURLIB) +             
  2. ~                         USRPRF(*OWNER) PUBAUT(*NORMAL)           ~*/          
  3.                                                                                 
  4.         /*~*******************************************************~*/           
  5.         /*~PROGRAM:  BACKUP.YOURLIB                               ~*/           
  6.         /*~DISCRIPTION: PROCESS BACKUP COMMANDS                   ~*/           
  7.         /*~                                                       ~*/           
  8.         /*~COMPILATION OPTIONS: NONE                              ~*/           
  9.         /*~SWITCHES: NONE                                         ~*/           
  10.         /*~                                                       ~*/           
  11.         /*~WRITEN BY BRIAN GREWAL.                                ~*/           
  12.         /*~                                                       ~*/           
  13.         /*~I TAKE NO RESPONSIBILITY OF FUNCTION OF THIS CODE.     ~*/           
  14.         /*~COMPILE AND EXECUTE IT AT YOUR OWN RISK.               ~*/           
  15.         /*~                                                       ~*/           
  16.         /*~                                                       ~*/           
  17.         /*~                                                       ~*/           
  18.         /*~*******************************************************~*/           
  19.                                                                                 
  20.              PGM        PARM(&BKPTYP &DEVICE &OBJ &LIB &SAVCOD &RTNCOD)         
  21.              DCL        &BKPTYP *CHAR 7                                         
  22.              DCL        &DEVICE *CHAR 1                                         
  23.              DCL        &OBJ *CHAR 550                                          
  24.              DCL        &LIB *CHAR 550                                          
  25.              DCL        &SAVCOD *CHAR 1                                         
  26.              DCL        VAR(&RTNCOD) TYPE(*CHAR) LEN(8)                         
  27.              DCL        &SAVF *CHAR 10                                          
  28.              DCL        &WLIB *CHAR 10                                          
  29.              DCL        &TEXT *CHAR 50                                          
  30.              DCL        &QDATE *CHAR 6                                          
  31.              DCL        VAR(&C1) TYPE(*DEC) LEN(3 0)                            
  32.              DCL        VAR(&C2) TYPE(*DEC) LEN(3 0) VALUE(1)                   
  33.              DCL        &WOBJS *CHAR 550                                        
  34.              DCL        &WLIBS *CHAR 550                                        
  35.              DCL        &CMD *CHAR 2000                                         
  36.              DCL        &RTNPOINT *CHAR 7                                       
  37.              DCL        &TYPE *CHAR 1                                           
  38.                                                                                 
  39.              DCL        &MSGID *CHAR 7                                          
  40.              DCL        &MSG *CHAR 200                                          
  41.              DCL        &MSGDTA *CHAR 100                                       
  42.              DCL        &MSGF *CHAR 10                                          
  43.              DCL        &MSGFLIB *CHAR 10                                       
  44.              DCL        VAR(&ATTR) TYPE(*CHAR) LEN(1) VALUE(X'2B')              
  45.              DCL        VAR(&NORMAL) TYPE(*CHAR) VALUE(X'20')                   
  46.                                                                                 
  47.              DCL        VAR(&RI) TYPE(*CHAR) LEN(1) VALUE(X'21')                
  48.                                                                                 
  49.              /*~        MONITOR FOR MESSAGES~*/                                 
  50.              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))                 
  51.                                                                                 
  52.              RTVSYSVAL  SYSVAL(QDATE) RTNVAR(&QDATE)                            
  53.              RTVJOBA    TYPE(&TYPE)                                             
  54.                                                                                 
  55.   /*~TRUNCATE EXTRA SPACES FROM OBJECT AND LIBRARY NAMES ~*/                    
  56.                                                                                 
  57.              IF         (&SAVCOD *EQ 'A') DO                                    
  58.  TCATA:      IF         (&C1 *LE 49) THEN(DO)                                   
  59.              CHGVAR     &C1 (&C1+1)                                             
  60.              IF         COND(&C1 = 1) THEN(CHGVAR VAR(&WLIBS) +                 
  61.                           VALUE(%SST(&LIB 1 10)))                               
  62.              ELSE       CMD(CHGVAR VAR(&WLIBS) VALUE(&WLIBS *BCAT +             
  63.                           %SST(&LIB &C2 10)))                                   
  64.              CHGVAR     &C2 (&C2+11)                                            
  65.              GOTO       TCATA                                                   
  66.              ENDDO      /*~ &C1 *LE 49~*/                                       
  67.              ENDDO      /*~ &SAVCOD *EQ 'A' ~*/                                 
  68.                                                                                 
  69.              CHGVAR     &C1 (&C1 * 0)                                           
  70.              CHGVAR     &C2 ((&C2 * 0) + 1)                                     
  71.                                                                                 
  72.              IF         (&SAVCOD *EQ 'S') DO                                    
  73.  TCATS:      IF         (&C1 *LE 49) THEN(DO)                                   
  74.              CHGVAR     &C1 (&C1+1)                                             
  75.              IF         COND(&C1 = 1) THEN(CHGVAR VAR(&WOBJS) +                 
  76.                           VALUE(%SST(&OBJ 1 10)))                               
  77.              ELSE       CMD(CHGVAR VAR(&WOBJS) VALUE(&WOBJS *BCAT +             
  78.                           %SST(&OBJ &C2 10)))                                   
  79.              CHGVAR     &C2 (&C2+11)                                            
  80.              GOTO       TCATS                                                   
  81.              ENDDO      /*~ &C1 *LE 49~*/                                       
  82.              ENDDO      /*~ &SAVCOD *EQ 'S' ~*/                                 
  83.                                                                                 
  84.              CHGVAR     &C1 (&C1 * 0)                                           
  85.              CHGVAR     &C2 ((&C2 * 0) + 1)                                     
  86.                                                                                 
  87.     /*~- - - - - - D A I L Y    B A C K    U P - - - - ~*/                      
  88.                                                                                 
  89.              /*~        PROCESS IF DAILY  BACKUP REQUESTED~*/                   
  90.                                                                                 
  91.              IF         COND(&BKPTYP *EQ 'DAILY  ') THEN(DO) /*~Daily +         
  92.                           ~                         +                           
  93.                           ~                         backup~*/                   
  94.                                                                                 
  95.  DAILY:      CHGVAR     &RTNPOINT 'DAILY  '                                     
  96.              IF         COND(&SAVCOD *EQ 'A') THEN(DO) /*~Objects +             
  97. ~                         *all~*/                                               
  98.                                                                                 
  99.   /*~SAVE TO SAVE FILE~*/                                                       
  100.                                                                                 
  101.              IF         COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/          
  102.  DALOOP:     IF         (&C1 *LE 49) THEN(DO)                                   
  103.              CHGVAR     &C1 (&C1+1)                                             
  104.              CHGVAR     &WLIB %SST(&LIB &C2 10)                                 
  105.              IF         (&WLIB *NE '          ') THEN(DO)                       
  106.              CHGVAR     &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +               
  107.                            %SST(&WLIB 7 4))                                     
  108.              CHGVAR     VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +              
  109.                           'save file for' *BCAT &WLIB *BCAT 'created' +         
  110.                           *BCAT &QDATE)                                         
  111.              CHKOBJ     OBJ(&SAVF.QGPL) OBJTYPE(*FILE)                          
  112.              MONMSG     MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))                
  113.              CHGSAVF    FILE(&SAVF.QGPL) TEXT(&TEXT)                            
  114.              CLRSAVF    FILE(&SAVF.QGPL)                                        
  115.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  116.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  117.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  118.                           *TCAT 'ALL' *TCAT '.' *TCAT &WLIB *TCAT +             
  119.                           &NORMAL *TCAT 'to savefile' *BCAT &SAVF +             
  120.                           *BCAT 'in process') TOPGMQ(*EXT) +                    
  121.                           MSGTYPE(*STATUS))                                     
  122.              SAVCHGOBJ  OBJ(*ALL) LIB(&WLIB) SAVF(&SAVF.QGPL) +                 
  123.                           DTACPR(*YES)                                          
  124.              ENDDO      /*~ &WLIB *NE *BLANKS ~*/                               
  125.              CHGVAR     VAR(&C2) VALUE(&C2 +11)                                 
  126.              GOTO       DALOOP                                                  
  127.              ENDDO      /*~IF &C1 LE 49~*/                                      
  128.              ENDDO      /*~ IF &DEVICE *EQ 'S' ~*/                              
  129.                                                                                 
  130.   /*~SAVE TO DISKETTE ~*/                                                       
  131.                                                                                 
  132.              IF         COND(&DEVICE *EQ 'D') THEN(DO)                          
  133.              CHGVAR     VAR(&CMD) VALUE('SAVCHGOBJ OBJ(*ALL) LIB(' +            
  134.                           *TCAT &WLIBS *TCAT ') LOC(*M12 *SEARCH) +             
  135.                           DTACPR(*YES) CLEAR(*YES)')                            
  136.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  137.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  138.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  139.                           *TCAT '*ALL' *TCAT '.' *TCAT &WLIBS *TCAT +           
  140.                           &NORMAL *BCAT 'to Diskette in process') +             
  141.                           TOPGMQ(*EXT) MSGTYPE(*STATUS))                        
  142.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  143.              ENDDO      /*~ DEVICE *EQ 'D' ~*/                                  
  144.                                                                                 
  145.   /*~SAVE TO TAPE ~*/                                                           
  146.                                                                                 
  147.              IF         COND(&DEVICE *EQ 'T') THEN(DO)                          
  148.              CHGVAR     VAR(&CMD) VALUE('SAVCHGOBJ OBJ(*ALL) LIB(' +            
  149.                           *TCAT &WLIBS *TCAT ') DEV(QTAPE1) +                   
  150.                           ENDOPT(*LEAVE)')                                      
  151.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  152.                           MSGID(CPF9898) MSGF(CPF9898.QSYS) +                   
  153.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  154.                           *TCAT '*ALL' *TCAT '.' *TCAT &WLIBS *TCAT +           
  155.                           &NORMAL *BCAT 'to Tape in process') +                 
  156.                           TOPGMQ(*EXT) MSGTYPE(*STATUS))                        
  157.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  158.              ENDDO      /*~ DEVICE *EQ 'T' ~*/                                  
  159.              ENDDO      /*~&SAVCOD IFEQ 'A'~*/                                  
  160.                                                                                 
  161.              ELSE       DO  /*~SAVE CODE EQ 'S'~*/                              
  162.   /*~SAVE TO SAVE FILE~*/                                                       
  163.                                                                                 
  164.              CHGVAR     &WLIB %SST(&LIB 1 10)                                   
  165.              IF         COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/          
  166.              CHGVAR     &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +               
  167.                            %SST(&WLIB 7 4))                                     
  168.              CHGVAR     VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +              
  169.                           'save file for' *BCAT &WLIB *BCAT 'created' +         
  170.                           *BCAT &QDATE)                                         
  171.              CHKOBJ     OBJ(&SAVF.QGPL) OBJTYPE(*FILE)                          
  172.              MONMSG     MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))                
  173.              CHGSAVF    FILE(&SAVF.QGPL) TEXT(&TEXT)                            
  174.              CLRSAVF    FILE(&SAVF.QGPL)                                        
  175.              CHGVAR     VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &WOBJS +            
  176.                           *TCAT ') LIB(' *TCAT &WLIB *TCAT ') SAVF(' +          
  177.                           *TCAT &SAVF *TCAT '.QGPL) DTACPR(*YES)')              
  178.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  179.                           MSGID(CPF9898) MSGF(CPF9898.QSYS) +                   
  180.                           MSGDTA(&BKPTYP *BCAT 'save of selected +              
  181.                           objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +         
  182.                           &NORMAL *BCAT 'to savefile' *BCAT &SAVF +             
  183.                           *BCAT 'in process') TOPGMQ(*EXT) +                    
  184.                           MSGTYPE(*STATUS))                                     
  185.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  186.              ENDDO      /*~ IF &DEVICE *EQ 'S' ~*/                              
  187.                                                                                 
  188.   /*~SAVE TO DISKETTE ~*/                                                       
  189.                                                                                 
  190.              IF         COND(&DEVICE *EQ 'D') THEN(DO)                          
  191.              CHGVAR     VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &WOBJS +            
  192.                           *TCAT ') LIB(' *TCAT &WLIB *TCAT ') +                 
  193.                           LOC(*M12 *SEARCH) DTACPR(*YES) CLEAR(*YES)')          
  194.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  195.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  196.                           MSGDTA(&BKPTYP *BCAT 'save of selected +              
  197.                           objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +         
  198.                           &NORMAL *BCAT 'to Diskette in process') +             
  199.                           TOPGMQ(*EXT) MSGTYPE(*STATUS))                        
  200.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  201.              ENDDO      /*~ IF &DEVICE *EQ 'D' ~*/                              
  202.                                                                                 
  203.   /*~SAVE TO TAPE ~*/                                                           
  204.                                                                                 
  205.              IF         COND(&DEVICE *EQ 'T') THEN(DO)                          
  206.              CHGVAR     VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &WOBJS +            
  207.                           *TCAT ') LIB(' *TCAT &WLIB *TCAT ') +                 
  208.                           DEV(QTAPE1) ENDOPT(*LEAVE)')                          
  209.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  210.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  211.                           MSGDTA(&BKPTYP *BCAT 'save of selected +              
  212.                           objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +         
  213.                           &NORMAL *BCAT 'to Tape in process') +                 
  214.                           TOPGMQ(*EXT) MSGTYPE(*STATUS))                        
  215.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  216.              ENDDO      /*~ IF &DEVICE *EQ 'T' ~*/                              
  217.              ENDDO      /*~SAVCOD *EQ 'S'~*/                                    
  218.                                                                                 
  219.              ENDDO      /*~ &BKPTYP *EQ 'DAILY'~*/                              
  220.                                                                                 
  221.     /*~- - - - - - - W E E K L Y    B A C K    U P - - - - ~*/                  
  222.     /*~- - - - - - - - - - - -  O R  - - - - - - - - - ~*/                      
  223.     /*~- - - - - S P E C I A L    B A C K    U P - - - ~*/                      
  224.                                                                                 
  225.              /*~        PROCESS IF SPECIAL OR WEEKLY REQUESTED~*/               
  226.                                                                                 
  227.              IF         COND((&BKPTYP *EQ 'WEEKLY ') *OR (&BKPTYP *EQ +         
  228.                           'SPECIAL')) THEN(DO) +                                
  229.                           /*~~                         Weekly backup~*/         
  230.                                                                                 
  231.  WEEKLY:     CHGVAR     &RTNPOINT 'WEEKLY '                                     
  232.              IF         COND(&SAVCOD *EQ 'A') THEN(DO) /*~Objects +             
  233. ~                         *all~*/                                               
  234.                                                                                 
  235.   /*~SAVE TO SAVE FILE~*/                                                       
  236.                                                                                 
  237.              IF         COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/          
  238.  WALOOP:     IF         (&C1 *LE 49) THEN(DO)                                   
  239.              CHGVAR     &C1 (&C1+1)                                             
  240.              CHGVAR     &WLIB %SST(&LIB &C2 10)                                 
  241.              IF         (&WLIB *NE '          ') THEN(DO)                       
  242.              CHGVAR     &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +               
  243.                            %SST(&WLIB 7 4))                                     
  244.              CHGVAR     VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +              
  245.                           'save file for' *BCAT &WLIB *BCAT 'created' +         
  246.                           *BCAT &QDATE)                                         
  247.              CHKOBJ     OBJ(&SAVF.QGPL) OBJTYPE(*FILE)                          
  248.              MONMSG     MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))                
  249.              CHGSAVF    FILE(&SAVF.QGPL) TEXT(&TEXT)                            
  250.              CLRSAVF    FILE(&SAVF.QGPL)                                        
  251.              CHGVAR     VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIB +             
  252.                           *TCAT ') SAVF(' *TCAT &SAVF *TCAT '.QGPL) +           
  253.                           DTACPR(*YES)')                                        
  254.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  255.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  256.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  257.                           *TCAT &WLIB *TCAT &NORMAL *TCAT 'to +                 
  258.                           savefile' *TCAT &ATTR *TCAT &SAVF *TCAT +             
  259.                           &NORMAL *TCAT 'in process') TOPGMQ(*EXT) +            
  260.                           MSGTYPE(*STATUS))                                     
  261.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  262.              ENDDO      /*~ &WLIB *NE *BLANKS ~*/                               
  263.              CHGVAR     &C2 (&C2+11)                                            
  264.              GOTO       WALOOP                                                  
  265.              ENDDO      /*~IF &C1 LE 49~*/                                      
  266.              ENDDO      /*~ IF &DEVICE *EQ 'S' ~*/                              
  267.                                                                                 
  268.   /*~SAVE TO DISKETTE ~*/                                                       
  269.                                                                                 
  270.              IF         COND(&DEVICE *EQ 'D') THEN(DO)                          
  271.              CHGVAR     VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +            
  272.                           *TCAT ') LOC(*M12 *SEARCH) DTACPR(*YES) +             
  273.                           CLEAR(*YES)')                                         
  274.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  275.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  276.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  277.                           *TCAT &WLIBS *TCAT &NORMAL *TCAT 'to +                
  278.                           Diskette in process') TOPGMQ(*EXT) +                  
  279.                           MSGTYPE(*STATUS))                                     
  280.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  281.              ENDDO      /*~ IF &DEVICE *EQ 'D' ~*/                              
  282.                                                                                 
  283.   /*~SAVE TO TAPE ~*/                                                           
  284.                                                                                 
  285.              IF         COND(&DEVICE *EQ 'T') THEN(DO)                          
  286.              CHGVAR     VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +            
  287.                           *TCAT ') DEV(QTAPE1) ENDOPT(*LEAVE)')                 
  288.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  289.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  290.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  291.                           *TCAT &WLIBS *TCAT &NORMAL *TCAT 'to Tape +           
  292.                           in process') TOPGMQ(*EXT) MSGTYPE(*STATUS))           
  293.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  294.              ENDDO      /*~ IF &DEVICE *EQ 'T' ~*/                              
  295.              ENDDO      /*~&SAVCOD IFEQ 'A'~*/                                  
  296.                                                                                 
  297.              ELSE       DO  /*~SAVE CODE EQ 'S'~*/                              
  298.   /*~SAVE TO SAVE FILE~*/                                                       
  299.                                                                                 
  300.              CHGVAR     &WLIB %SST(&LIB 1 10)                                   
  301.              IF         COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/          
  302.              CHGVAR     &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +               
  303.                         %SST(&WLIB 7 4))                                        
  304.              CHGVAR     VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +              
  305.                           'save file for' *BCAT &WLIB *BCAT 'created' +         
  306.                           *BCAT &QDATE)                                         
  307.              CHKOBJ     OBJ(&SAVF.QGPL) OBJTYPE(*FILE)                          
  308.              MONMSG     MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))                
  309.              CHGSAVF    FILE(&SAVF.QGPL) TEXT(&TEXT)                            
  310.              CLRSAVF    FILE(&SAVF.QGPL)                                        
  311.              CHGVAR     VAR(&CMD) VALUE('SAVOBJ  OBJ(' *TCAT &WOBJS +           
  312.                           *TCAT ') LIB(' *TCAT &WLIB *TCAT ') +                 
  313.                           SAVF(&SAVF.QGPL) DTACPR(*YES)')                       
  314.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  315.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  316.                           MSGDTA(&BKPTYP *BCAT 'save of selected +              
  317.                           objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +         
  318.                           &NORMAL *BCAT 'to savefile' *BCAT &SAVF +             
  319.                           *BCAT 'in process') TOPGMQ(*EXT) +                    
  320.                           MSGTYPE(*STATUS))                                     
  321.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  322.              ENDDO      /*~ IF &DEVICE *EQ 'S' ~*/                              
  323.                                                                                 
  324.   /*~SAVE TO DISKETTE ~*/                                                       
  325.                                                                                 
  326.              IF         COND(&DEVICE *EQ 'D') THEN(DO)                          
  327.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  328.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  329.                           MSGDTA(&BKPTYP *BCAT 'save of selected +              
  330.                           objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +         
  331.                           &NORMAL *BCAT 'to Diskette in process') +             
  332.                           TOPGMQ(*EXT) MSGTYPE(*STATUS))                        
  333.                SAVOBJ     OBJ(&WOBJS) LIB(&WLIB) LOC(*M12 *SEARCH) +            
  334.                           DTACPR(*YES)                                          
  335.              ENDDO      /*~Device *eq 'D'~*/                                    
  336.                                                                                 
  337.   /*~SAVE TO TAPE ~*/                                                           
  338.                                                                                 
  339.              IF         COND(&DEVICE *EQ 'T') THEN(DO)                          
  340.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  341.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  342.                           MSGDTA(&BKPTYP *BCAT 'save of selected +              
  343.                           objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +         
  344.                           &NORMAL *BCAT 'to Tape in process') +                 
  345.                           TOPGMQ(*EXT) MSGTYPE(*STATUS))                        
  346.                 SAVOBJ    OBJ(&WOBJS) LIB(&WLIB) DEV(QTAPE1) +                  
  347.                           ENDOPT(*LEAVE)                                        
  348.              ENDDO      /*~DEVICE *EQ 'T'~*/                                    
  349.              ENDDO      /*~SAVCOD *EQ 'S'~*/                                    
  350.                                                                                 
  351.              ENDDO      /*~ &BKPTYP *EQ 'WEEKLY'~*/                             
  352.                                                                                 
  353.     /*~- - - - - - - M O N T H L Y    B A C K    U P - - - - ~*/                
  354.                                                                                 
  355.              /*~        PROCESS IF DAILY MONTHLY REQUESTED~*/                   
  356.                                                                                 
  357.              IF         COND(&BKPTYP *EQ 'MONTHLY ') THEN(DO) /*~+              
  358. ~                         Weekly backup~*/                                      
  359.                                                                                 
  360.  MONTHLY:    CHGVAR     &RTNPOINT 'MONTHLY'                                     
  361.              IF         COND(&SAVCOD *EQ 'A') THEN(DO) /*~Objects +             
  362. ~                         *all~*/                                               
  363.                                                                                 
  364.   /*~SAVE TO SAVE FILE~*/                                                       
  365.                                                                                 
  366.              IF         COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/          
  367.  MALOOP:     IF         (&C1 *LE 9) THEN(DO)                                    
  368.              CHGVAR     &C1 (&C1+1)                                             
  369.              CHGVAR     &WLIB %SST(&LIB &C2 10)                                 
  370.              IF         (&WLIB *NE '          ') THEN(DO)                       
  371.              CHGVAR     &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +               
  372.                           %SST(&WLIB 7 4))                                      
  373.              CHGVAR     VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +              
  374.                           'save file for' *BCAT &WLIB *BCAT 'created' +         
  375.                           *BCAT &QDATE)                                         
  376.              CHKOBJ     OBJ(&SAVF.QGPL) OBJTYPE(*FILE)                          
  377.              MONMSG     MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))                
  378.              CHGSAVF    FILE(&SAVF.QGPL) TEXT(&TEXT)                            
  379.              CLRSAVF    FILE(&SAVF.QGPL)                                        
  380.              CHGVAR     VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIB +             
  381.                           *TCAT ') SAVF(' *TCAT &SAVF *TCAT '.QGPL) +           
  382.                           DTACPR(*YES)')                                        
  383.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  384.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  385.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  386.                           *TCAT &WLIB *TCAT &NORMAL *TCAT 'to +                 
  387.                           savefile' *BCAT &SAVF *BCAT 'in process') +           
  388.                           TOPGMQ(*EXT) MSGTYPE(*STATUS))                        
  389.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  390.              ENDDO      /*~ &WLIB *NE *BLANKS ~*/                               
  391.              CHGVAR     &C2 (&C2+11)                                            
  392.              GOTO       MALOOP                                                  
  393.              ENDDO      /*~IF &C1 LE 9~*/                                       
  394.              ENDDO      /*~ IF &DEVICE *EQ 'S' ~*/                              
  395.                                                                                 
  396.   /*~SAVE TO DISKETTE ~*/                                                       
  397.                                                                                 
  398.              IF         COND(&DEVICE *EQ 'D') THEN(DO)                          
  399.              CHGVAR     VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +            
  400.                           *TCAT ') LOC(*M12 *SEARCH) DTACPR(*YES) +             
  401.                           CLEAR(*YES)')                                         
  402.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  403.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  404.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  405.                           *TCAT &WLIBS *TCAT &NORMAL *TCAT 'to +                
  406.                           Diskette in process') TOPGMQ(*EXT) +                  
  407.                           MSGTYPE(*STATUS))                                     
  408.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  409.              ENDDO      /*~ IF &DEVICE *EQ 'D' ~*/                              
  410.                                                                                 
  411.   /*~SAVE TO TAPE ~*/                                                           
  412.                                                                                 
  413.              IF         COND(&DEVICE *EQ 'T') THEN(DO)                          
  414.              CHGVAR     VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +            
  415.                           *TCAT ') DEV(QTAPE1) ENDOPT(*LEAVE)')                 
  416.              IF         COND(&TYPE = '1') THEN(SNDPGMMSG +                      
  417.                           MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +                   
  418.                           MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +          
  419.                           *TCAT &WLIBS *TCAT &NORMAL *TCAT 'to Tape +           
  420.                           in process') TOPGMQ(*EXT) MSGTYPE(*STATUS))           
  421.              CALL       PGM(QCAEXEC) PARM(&CMD 2000)                            
  422.              ENDDO      /*~ IF &DEVICE *EQ 'T' ~*/                              
  423.              ENDDO      /*~&SAVCOD IFEQ 'A'~*/                                  
  424.                                                                                 
  425.              ENDDO      /*~ &BKPTYP *EQ 'MONTHLY'~*/                            
  426.              RETURN                                                             
  427.                                                                                 
  428.  ERROR:      /*~STANDARD ERROR HANDLING ROUTINE~*/                              
  429.              RCVMSG     MSGTYPE(*EXCP) MSG(&MSG) MSGDTA(&MSGDTA) +              
  430.                           MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGFLIB)           
  431.              IF         COND(&MSGID *EQ 'CPF3793') THEN(DO)                     
  432.              CHGVAR     VAR(&RTNCOD) VALUE('ABORT  ')                           
  433.              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGF.&MSGFLIB) +                    
  434.                           MSGDTA(&MSGDTA) TOMSGQ(QSYSOPR) +                     
  435.                           MSGTYPE(*ESCAPE)                                      
  436.              ENDDO                                                              
  437.              ELSE       DO                                                      
  438.              CHGVAR     &C2 (&C2+11)                                            
  439.              SNDMSG     MSG(&MSG) TOMSGQ(QSYSOPR) MSGTYPE(*INFO)                
  440.              IF         (&RTNPOINT *EQ 'DAILY  ') GOTO DAILY                    
  441.              IF         (&RTNPOINT *EQ 'WEEKLY ') GOTO WEEKLY                   
  442.              IF         (&RTNPOINT *EQ 'MONTHLY') GOTO MONTHLY                  
  443.              ENDDO                                                              
  444.              ENDPGM                                                             
  445.